PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/memstr.com/MEMSTR.PAS

Pascal/Delphi Source File | 1989-05-09 | 10.0 KB | 301 lines

{ ========================================================================= }
PROGRAM MemStr;

{ Version 8906.01 }
{ Written in Turbo Pascal, Version 5.0 }
{ Turbo Pascal is a product of Borland International. }
{ Turbo Professional is a product of TurboPower Software
{ ========================================================================= }

{$R-}    {Range checking off}
{$B+}    {Boolean complete evaluation on}
{$S+}    {Stack checking on}
{$I+}    {I/O checking on}
{$N+,E+} {Simulate numeric coprocessor}
{$M 65500,16384,655360} {Turbo 3 default stack and heap}
{$V-}    {Variable range checking off}

{ ========================================================================= }
(*
This program uses the TPDOS and TPCRT units of Turbo Professional from
Turbo Power Software.  If you do not have Turbo Professional, change
the USES declarations to DOS and CRT and take out the call to the
ExistAnyFile procedure.
*)
{ ========================================================================= }

USES
  TpDos,                  { Turbo Professional unit }
  TpCrt;                  { Turbo Professional unit }


TYPE
  String12       = String [12];

{ ========================================================================= }
{ superstring routines }
{ ========================================================================= }

(*
MEMSTR.PAS is a demonstration of a technique for storing a file of
strings in a memory array at runtime.

I was working on a program which needed to make random choices of words.
For speed purposes, I needed to hold all the different words in memory,
but at the same time, I also needed to store the words in ASCII files
that I would maintain with a word processor.  I did not want to have to
recompile the program every time I added or deleted a choice from a file.
To load all the different selections into memory, no matter how many
there were in the file, meant declaring an array at runtime.  I did this
by setting aside memory on the heap and declaring pointers to that memory.

HOW IT WORKS:

The trick lies in declaring two types that are larger than the maximum
amount of data you ever expect to use.  SuperArray and SuperCount are
deliberately oversized arrays.  SuperArray is the maximum size array of
characters possible in Turbo Pascal 5.0.  SuperCount is more entries
than I expect to access.  If I ever need to access more than 1024 separate
items, all I have to do is increase the upper range of SuperCount.

The program then declares two pointer types to access these array types and
then a SuperString type which is a record containing both pointer types and
a Size variable to log the amount of data stored in the SuperArray.  The
total number of entries is stashed in ArrayPtr^ [0].  Any individual
SuperString will be marked by only six bytes, pointing to two areas of
heap, set aside at runtime.
*)

{ ========================================================================= }

TYPE
  SuperArray     = Array [1 .. 65535] of char;   { max array size }
  SuperCount     = Array [0 .. 1024] of word;    { max num of entries }
  EntryPtrType   = ^SuperArray;
  ArrayPtrType   = ^SuperCount;

  SuperString    = Record
                     EntryPtr : EntryPtrType;
                     ArrayPtr : ArrayPtrType;
                     Size     : Word;
                   End;

{ ========================================================================= }

FUNCTION ExistAnyFile (FileName : String12) : Boolean;
{ Checks to see if a file exists before accessing it. }

VAR
  SaveMode : Byte;

BEGIN
  SaveMode := FileMode;
  FileMode := 0;
  ExistAnyFile := ExistFile (FileName);          { TpDos function }
  FileMode := SaveMode;
END;

{ ========================================================================= }

(*
The BuildSuperString procedure needs to be run once to initialize
the superstring.

It reads the file, counting the entries and totalling their lengths;
then it reserves the appropriate amount of space on the heap and assigns
the starting locations to ArrayPtr^ and EntryPtr^, using Turbo's GetMem
procedure.

Then it resets the file, reads the entries again and stashes each entry
in EntryPtr^ and its starting location (relative to EntryPtr^ [1]) in
ArrayPtr^.  It would be more efficient if the program actually stored a
pointer to the actual address.  This improvement is left as an exercise
for someone who is more proficient in pointer arithmetic than I am.
However there is an advantage in this method in that I save one byte of
data for every entry, because I am not bothering to store the length byte
of the individual strings;  it isn't necessary.
*)

{ ========================================================================= }

PROCEDURE BuildSuperString (FileName  : String12;
                            VAR Super : SuperString);

VAR
  ReadStr       : String;
  ReadFile      : Text;
  Count         : Word;

BEGIN
With Super do
  begin
  If ExistAnyFile (FileName) then
    begin
    WriteLn ('Initializing ', FileName);
    Assign (ReadFile, FileName);                 { open file }
    Reset (ReadFile);

    { Count number of entries in file }
    Count := 0;
    Size  := 0;
    While not EOF (ReadFile) do
      begin
      ReadLn (ReadFile, ReadStr);
      If ReadStr > '' then                       { skip blank strings }
        If ReadStr [1] <> '{' then               { skip comments }
          begin
          inc (Count);                           { count number of entries }
          inc (Size, Length (ReadStr));          { add length }
          end;
      end;
    GetMem (EntryPtr, Size);                     { memory for superstring }
    GetMem (ArrayPtr, 2 * Count + 4);            { memory for pointers }
    ArrayPtr^ [0] := Count;

    Reset (ReadFile);                            { go to start of file }
    Count := 1;
    Size  := 0;
    While not EOF (ReadFile) do
      begin
      ReadLn (ReadFile, ReadStr);
      If ReadStr > '' then                       { skip blank strings }
        If ReadStr [1] <> '{' then               { skip comments }
          begin
          ArrayPtr^ [Count] := succ (Size);      { determine start of entry }
          move (ReadStr [1],
                EntryPtr^ [ArrayPtr^ [Count]],
                Length (ReadStr));               { store entry }
          inc (Count);                           { add to count }
          inc (Size, Length (ReadStr));          { add to size }
          end;
      end;
    ArrayPtr^ [Count] := succ (Size);            { determine start of entry }
    Close (ReadFile);
    end
  else
    begin
    EntryPtr := nil;
    ArrayPtr := nil;
    Size := 0;
    end;
  end;
END;

{ ========================================================================= }

(*
Once all the data is stored in a superstring, it can be instantly accessed
by a call to the GetWord function:

S := GetWord (Super, Num);

This will access the superstring and pull out the numth entry.  The function
GetWord will not return a string unless there is a valid entry.

First, it determines Len (the length of the desired word) by subtracting
the starting location of the word from the starting location of the
subsequent word.  (The total length of the SuperString is stored in the
last byte of the array pointed to by ArrayPtr^, so that the last word
is also accessible.)  The value of Len is automatically stored in S[0].

Then, having determined the length of the numth word, it moves that many
characters from EntryPtr^ [ArrayPtr [num]] to S[1], and returns S.
*)

{ ========================================================================= }

FUNCTION GetWord (Super : SuperString;  Num : Word) : String;

VAR
  S   : String;
  Len : Byte absolute S;                         { the length byte of S }

BEGIN
With Super do
  begin
  If
    (Size = 0) or (ArrayPtr = nil) or (EntryPtr = nil)
      or
    (Num > ArrayPtr^ [0])
  then
    GetWord := ''
  else
    begin
    Len := ArrayPtr^ [Succ (Num)] - ArrayPtr^ [Num];   { get its length }
    move (EntryPtr^ [ArrayPtr^ [Num]], S [1], Len);    { move word to string }
    GetWord := S;
    end;
  end;
END;

{ ========================================================================= }

PROCEDURE DisposeSuperString (Super : SuperString);
Begin
With Super do
  begin
  If ArrayPtr <> nil then FreeMem (ArrayPtr, Succ (ArrayPtr^ [0]));
  If EntryPtr <> nil then FreeMem (EntryPtr, Size);
  ArrayPtr := nil;
  EntryPtr := nil;
  Size := 0;
  end;
end;

{ ========================================================================= }

VAR
  OrdinalSet,
  GreekSet   : SuperString;

{ ========================================================================= }

PROCEDURE InitFiles;

BEGIN
BuildSuperString ('Ordinal.Dat', OrdinalSet);
BuildSuperString ('Greek.Dat', GreekSet);
END;

{ ========================================================================= }

(*
QuitProgram demonstrates how to reclaim the heap memory.  When the program
quits, the heap memory is automatically returned to DOS, of course;  but
if you need to release memory before the end of the program, use
DisposeSuperString or QuitProgram;
*)

{ ========================================================================= }

PROCEDURE QuitProgram;

BEGIN
DisposeSuperString (GreekSet);
DisposeSuperString (OrdinalSet);
END;

{ ========================================================================= }

VAR
  Loop : Word;

BEGIN
ClrScr;
InitFiles;                                       { read files into memory }
WriteLn;

For Loop := 1 to 12 do
  If
    (Loop <= OrdinalSet.ArrayPtr^ [0]) and (Loop <= GreekSet.ArrayPtr^ [0])
  then
    WriteLn ('The ', GetWord (OrdinalSet, Loop),
             ' letter of the Greek alphabet is ',
             GetWord (GreekSet, Loop),'.');

QuitProgram;                                     { discard heap memory }
END.

{ ========================================================================= }